VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "IGame"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

Private Declare Function CreateSolidBrush Lib "gdi32.dll" (ByVal crColor As Long) As Long
Private Declare Function DeleteObject Lib "gdi32.dll" (ByVal hObject As Long) As Long
Private Declare Function SelectObject Lib "gdi32.dll" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function CreatePen Lib "gdi32.dll" (ByVal nPenStyle As Long, ByVal nWidth As Long, ByVal crColor As Long) As Long
Private Declare Function FillRect Lib "user32.dll" (ByVal hdc As Long, ByRef lpRect As RECT, ByVal hBrush As Long) As Long
Private Declare Function FrameRect Lib "user32.dll" (ByVal hdc As Long, ByRef lpRect As RECT, ByVal hBrush As Long) As Long
Private Declare Function PolyPolyline Lib "gdi32.dll" (ByVal hdc As Long, ByRef lppt As POINTAPI, ByRef lpdwPolyPoints As Long, ByVal cCount As Long) As Long
Private Declare Function Polygon Lib "gdi32.dll" (ByVal hdc As Long, ByRef lpPoint As POINTAPI, ByVal nCount As Long) As Long
Private Declare Function GetStockObject Lib "gdi32.dll" (ByVal nIndex As Long) As Long
Private Declare Function Ellipse Lib "gdi32.dll" (ByVal hdc As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function SetROP2 Lib "gdi32.dll" (ByVal hdc As Long, ByVal nDrawMode As Long) As Long
Private Declare Function Rectangle Lib "gdi32.dll" (ByVal hdc As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long

Private Const NULL_BRUSH As Long = 5
Private Const NULL_PEN As Long = 8
Private Const BLACK_BRUSH As Long = 4
Private Const WHITE_BRUSH As Long = 0
Private Const WHITE_PEN As Long = 6

Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type

Private Type POINTAPI
    x As Long
    y As Long
End Type

Private m_t As typeFakeLaserLevel

'LSB-->MSB down(rgba),left(rgba),up(rgba),right(rgba),isCorrect
Private m_nLaserData(255) As Long

Private m_bWin As Boolean

'for game mode
Private m_nLastIndex As Long
Private m_nCurrentIndex As Long
Private m_bClicked As Boolean
Private m_nHintIndex As Long

'for edit mode
Private m_nEditTool As Long
Private m_nEditItemType As Long

Friend Property Get EditTool() As Long
EditTool = m_nEditTool
End Property

Friend Property Let EditTool(ByVal n As Long)
If n >= 0 And n <= &H1F& And n <> m_nEditTool Then
 m_nEditTool = n
 '///
 m_nLastIndex = -1
 m_nCurrentIndex = -1
 m_bClicked = False
End If
End Property

Friend Function IsObject(ByVal b As Long) As Boolean
Select Case b
Case 2 To 5, &HA& To &H16&, &H1B& To &H1D&
 IsObject = True
End Select
End Function

Friend Function OnMouseDown(ByVal Button As MouseButtonConstants, ByVal Shift As ShiftConstants, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal bEditMode As Boolean) As Boolean
Dim i As Long, b As Long
Dim bCancel As Boolean
'///
If m_t.nWidth < 1 Or m_t.nHeight < 1 Or x < 0 Or y < 0 Then Exit Function
'///calc size
nWidth = nWidth \ m_t.nWidth
nHeight = nHeight \ m_t.nHeight
If nWidth > nHeight Then nWidth = nHeight
'///
x = x \ nWidth
y = y \ nWidth
If x >= 0 And x < m_t.nWidth And y >= 0 And y < m_t.nHeight Then x = y * 16& + x _
Else x = -1
'///
If bEditMode And m_nEditTool > 0 Then
 If x >= 0 Then
  If Button = vbRightButton Then
   Select Case m_nEditTool
   Case 1 'set hint
    If m_t.nHintCount > 0 Then
     m_t.nHintCount = 0
     OnMouseDown = True
    End If
    b = -1
   Case Else
    b = 0
   End Select
  Else
   Select Case m_nEditTool
   Case 1 'set hint
    If m_t.nHintCount >= 4 Then 'too many hints
     Beep
    Else
     If IsObject(m_t.bData(x)) Then
      For i = 0 To m_t.nHintCount - 1
       If m_t.bObjectPos(i) = x Then Exit For
      Next i
      If i >= m_t.nHintCount Then
       m_t.bObjectPos(m_t.nHintCount) = x
       m_t.nHintCount = m_t.nHintCount + 1
       OnMouseDown = True
      Else
       Beep
      End If
     Else
      Beep
     End If
    End If
    b = -1
   Case Else
    b = m_nEditTool - 2
   End Select
  End If
 Else
  Beep
  b = -1
 End If
 If b >= 0 Then
  If m_t.bData(x) <> b Then
   m_t.bData(x) = b
   UpdateGameState
   OnMouseDown = True
  End If
 End If
 m_nEditItemType = b
 Exit Function
End If
'///
If Button = vbRightButton Then
 bCancel = True
ElseIf x >= 0 Then
 b = m_t.bData(x)
 If m_bClicked And m_nLastIndex >= 0 Then
  '///check new position
  If b = 0 Or IsObject(b) Or bEditMode Then
   m_t.bData(x) = m_t.bData(m_nLastIndex)
   m_t.bData(m_nLastIndex) = b
   If bEditMode Then
    For y = 0 To m_t.nHintCount - 1
     If m_t.bObjectPos(y) = m_nLastIndex Then m_t.bObjectPos(y) = x _
     Else If m_t.bObjectPos(y) = x Then m_t.bObjectPos(y) = m_nLastIndex
    Next y
   End If
   UpdateGameState
  Else
   Beep
  End If
  bCancel = True
 Else
  '///select object
  If IsObject(b) Or (bEditMode And b > 0) Then
   m_nLastIndex = x
   OnMouseDown = True
  Else
   Beep
  End If
 End If
Else
 Beep
 bCancel = True
End If
'///
If bCancel Then
 If m_nLastIndex >= 0 Or m_nCurrentIndex >= 0 Then
  m_nLastIndex = -1
  m_nCurrentIndex = -1
  m_nHintIndex = -1
  m_bClicked = False
  OnMouseDown = True
 End If
End If
End Function

Friend Function OnMouseMove(ByVal Button As MouseButtonConstants, ByVal Shift As ShiftConstants, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal bEditMode As Boolean) As Boolean
If (m_nLastIndex < 0 And Not bEditMode) Or (Button = 0 And Not m_bClicked) Then Exit Function
If m_t.nWidth < 1 Or m_t.nHeight < 1 Or x < 0 Or y < 0 Then Exit Function
'///calc size
nWidth = nWidth \ m_t.nWidth
nHeight = nHeight \ m_t.nHeight
If nWidth > nHeight Then nWidth = nHeight
x = x \ nWidth
y = y \ nWidth
If x >= 0 And x < m_t.nWidth And y >= 0 And y < m_t.nHeight Then
 x = y * 16& + x
 If bEditMode And m_nEditTool > 0 Then
  If m_nEditItemType >= 0 Then
   If m_t.bData(x) <> m_nEditItemType Then
    m_t.bData(x) = m_nEditItemType
    UpdateGameState
    OnMouseMove = True
   End If
  End If
 ElseIf m_nLastIndex >= 0 Then
  If x <> m_nCurrentIndex Then
   m_nCurrentIndex = x
   OnMouseMove = True
  End If
 End If
End If
End Function

Friend Function OnMouseUp(ByVal Button As MouseButtonConstants, ByVal Shift As ShiftConstants, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal bEditMode As Boolean) As Boolean
Dim b As Long
Dim bCancel As Boolean
'///
If bEditMode And m_nEditTool > 0 Then Exit Function
If m_t.nWidth < 1 Or m_t.nHeight < 1 Or x < 0 Or y < 0 Then Exit Function
'///calc size
If Button = vbRightButton Then
 bCancel = True
ElseIf m_nLastIndex >= 0 And Not m_bClicked Then
 '///calc size
 nWidth = nWidth \ m_t.nWidth
 nHeight = nHeight \ m_t.nHeight
 If nWidth > nHeight Then nWidth = nHeight
 '///
 x = x \ nWidth
 y = y \ nWidth
 If x >= 0 And x < m_t.nWidth And y >= 0 And y < m_t.nHeight Then
  x = y * 16& + x
  If x = m_nLastIndex Then
   m_bClicked = True
  Else
   b = m_t.bData(x)
   '///check new position
   If b = 0 Or IsObject(b) Or bEditMode Then
    m_t.bData(x) = m_t.bData(m_nLastIndex)
    m_t.bData(m_nLastIndex) = b
    If bEditMode Then
     For y = 0 To m_t.nHintCount - 1
      If m_t.bObjectPos(y) = m_nLastIndex Then m_t.bObjectPos(y) = x _
      Else If m_t.bObjectPos(y) = x Then m_t.bObjectPos(y) = m_nLastIndex
     Next y
    End If
    UpdateGameState
   Else
    Beep
   End If
   bCancel = True
  End If
 Else
  Beep
  bCancel = True
 End If
End If
'///
If bCancel Then
 If m_nLastIndex >= 0 Or m_nCurrentIndex >= 0 Then
  m_nLastIndex = -1
  m_nCurrentIndex = -1
  m_nHintIndex = -1
  m_bClicked = False
  OnMouseUp = True
 End If
End If
End Function

Friend Property Get IsWin() As Boolean
IsWin = m_bWin
End Property

Friend Sub UpdateGameState()
Dim i As Long, j As Long
Dim b As Long
Dim idx As Long, clr As Long
Dim clr2(3) As Long
Dim d As Long
Dim nStackPointer As Long
Dim nStack(4095) As Long 'bit0-15:pos bit16-19:color bit20-21:dir
'///
Erase m_nLaserData
'///
For j = 0 To m_t.nHeight - 1
 For i = 0 To m_t.nWidth - 1
  idx = j * 16& + i
  Select Case m_t.bData(idx)
  Case 2 'down laser
   m_nLaserData(idx) = m_nLaserData(idx) Or &H7&
   If j < m_t.nHeight - 1 Then
    nStack(nStackPointer) = i Or ((j + 1) * &H100&) Or &H70000
    nStackPointer = nStackPointer + 1
   End If
  Case 3 'left laser
   m_nLaserData(idx) = m_nLaserData(idx) Or &H70&
   If i > 0 Then
    nStack(nStackPointer) = (i - 1) Or (j * &H100&) Or &H170000
    nStackPointer = nStackPointer + 1
   End If
  Case 4 'up laser
   m_nLaserData(idx) = m_nLaserData(idx) Or &H700&
   If j > 0 Then
    nStack(nStackPointer) = i Or ((j - 1) * &H100&) Or &H270000
    nStackPointer = nStackPointer + 1
   End If
  Case 5 'right laser
   m_nLaserData(idx) = m_nLaserData(idx) Or &H7000&
   If i < m_t.nWidth - 1 Then
    nStack(nStackPointer) = (i + 1) Or (j * &H100&) Or &H370000
    nStackPointer = nStackPointer + 1
   End If
  End Select
 Next i
Next j
'///run DFS
Do While nStackPointer > 0
 '///pop stack
 nStackPointer = nStackPointer - 1
 i = nStack(nStackPointer)
 d = (i And &H300000) \ &H100000
 clr = (i And &HF0000) \ &H10000
 j = (i And &HFF00&) \ &H100&
 i = i And &HFF&
 If i < m_t.nWidth And j < m_t.nHeight Then
  clr2(0) = 0
  clr2(1) = 0
  clr2(2) = 0
  clr2(3) = 0
  '///
  idx = j * 16& + i
  b = m_t.bData(idx)
  Select Case b
  Case 0, &H6& To &HC&, &H17& To &H1D& 'empty or target or colored block
   Select Case b
   Case &HA&: clr = clr And &H1&
   Case &HB&: clr = clr And &H2&
   Case &HC&: clr = clr And &H4&
   Case &H1B&: clr = clr And &H3&
   Case &H1C&: clr = clr And &H5&
   Case &H1D&: clr = clr And &H6&
   End Select
   b = clr * &H101&
   If d And 1& Then b = b * &H10&
   m_nLaserData(idx) = m_nLaserData(idx) Or b
   clr2(d) = clr
  Case &HD& '\-mirror
   If d <= 1 Then b = clr * &H1100& Else b = clr * &H11&
   m_nLaserData(idx) = m_nLaserData(idx) Or b
   clr2(d Xor 3&) = clr
  Case &HE& '/-mirror
   If d = 0 Or d = 3 Then b = clr * &H110& Else b = clr * &H1001&
   m_nLaserData(idx) = m_nLaserData(idx) Or b
   clr2(d Xor 1&) = clr
  Case &HF& To &H12& 'splitter
   If d = ((b - &HF&) Xor 2&) Then
    Select Case d
    Case 0: b = clr * &H1110&
    Case 1: b = clr * &H1101&
    Case 2: b = clr * &H1011&
    Case 3: b = clr * &H111&
    End Select
    m_nLaserData(idx) = m_nLaserData(idx) Or b
    clr2(d Xor 1&) = clr
    clr2(d Xor 3&) = clr
   End If
  Case &H13 To &H16& 'prism
   If d = ((b - &H13&) Xor 2&) Then
    Select Case d
    Case 0: b = &H4721&
    Case 1: b = &H7214&
    Case 2: b = &H2147&
    Case 3: b = &H1472&
    End Select
    b = b And (clr * &H1111&)
    m_nLaserData(idx) = m_nLaserData(idx) Or b
    clr2(d) = clr And &H1&
    clr2((d + 1) And &H3&) = clr And &H2&
    clr2((d - 1) And &H3&) = clr And &H4&
   End If
  End Select
  '///push stack
  If clr2(0) > 0 Then 'down
   nStack(nStackPointer) = i Or ((j + 1) * &H100&) Or (clr2(0) * &H10000)
   nStackPointer = nStackPointer + 1
  End If
  If clr2(1) > 0 Then 'left
   nStack(nStackPointer) = (i - 1) Or (j * &H100&) Or (clr2(1) * &H10000) Or &H100000
   nStackPointer = nStackPointer + 1
  End If
  If clr2(2) > 0 Then 'up
   nStack(nStackPointer) = i Or ((j - 1) * &H100&) Or (clr2(2) * &H10000) Or &H200000
   nStackPointer = nStackPointer + 1
  End If
  If clr2(3) > 0 Then 'right
   nStack(nStackPointer) = (i + 1) Or (j * &H100&) Or (clr2(3) * &H10000) Or &H300000
   nStackPointer = nStackPointer + 1
  End If
 End If
Loop
'///check target state
clr2(0) = 0
clr2(1) = 0
For j = 0 To m_t.nHeight - 1
 For i = 0 To m_t.nWidth - 1
  idx = j * 16& + i
  b = m_t.bData(idx)
  Select Case b
  Case 6 To 9, &H17& To &H1A&
   clr2(0) = clr2(0) + 1
   clr = m_nLaserData(idx)
   d = clr And &HF&
   If clr And &HF0& Then
    If d Then d = -1 Else d = (clr And &HF0&) \ &H10&
   End If
   '///
   Select Case b
   Case 6: clr = 7
   Case 7: clr = 1
   Case 8: clr = 2
   Case 9: clr = 4
   Case &H17&: clr = 3
   Case &H18&: clr = 5
   Case &H19&: clr = 6
   Case &H1A&: clr = 0
   End Select
   If d = clr Then
    m_nLaserData(idx) = m_nLaserData(idx) Or &H10000
    clr2(1) = clr2(1) + 1
   End If
  End Select
 Next i
Next j
m_bWin = clr2(0) > 0 And clr2(0) = clr2(1)
End Sub

Friend Function ShowHint() As Boolean
Dim i As Long, j As Long, k As Long, b As Long
Dim idx As Long
'///find hint
For k = 0 To m_t.nHintCount - 1
 idx = m_t.bObjectPos(k)
 b = m_t.bObjectType(k)
 If IsObject(b) And m_t.bData(idx) <> b Then
  For j = 0 To m_t.nHeight - 1
   For i = 0 To m_t.nWidth - 1
    If m_t.bData(j * 16& + i) = b Then
     m_nHintIndex = (j * 16& + i) Or (idx * &H100&)
     ShowHint = True
     Exit Function
    End If
   Next i
  Next j
 End If
Next k
'///no more hints
m_nHintIndex = -1
End Function

Friend Sub CreateFromLevel(ByRef t As typeFakeLaserLevel, ByVal bRemoveObject As Boolean)
Dim i As Long, j As Long, b As Long
Dim nCount(255) As Long
'///
m_nLastIndex = -1
m_nCurrentIndex = -1
m_nHintIndex = -1
m_bClicked = False
'///
m_t = t
If bRemoveObject Then
 For i = 0 To m_t.nObjectCount - 1
  b = m_t.bObjectType(i)
  Select Case b
  Case 6 To 9, &H17& To &H1A& 'target
   m_t.bData(m_t.bObjectPos(i)) = b
  Case Else
   nCount(b) = nCount(b) + 1
  End Select
 Next i
 'put down/right laser
 For j = m_t.nHeight - 1 To 0 Step -1
  If nCount(2) + nCount(5) = 0 Then Exit For
  For i = m_t.nWidth - 1 To 0 Step -1
   If m_t.bData(j * 16& + i) = 0 Then
    If nCount(2) > 0 Then
     m_t.bData(j * 16& + i) = 2
     nCount(2) = nCount(2) - 1
    ElseIf nCount(5) > 0 Then
     m_t.bData(j * 16& + i) = 5
     nCount(5) = nCount(5) - 1
    Else
     Exit For
    End If
   End If
  Next i
 Next j
 'put other objects
 b = 3
 For j = 0 To m_t.nHeight - 1
  If b < 0 Then Exit For
  For i = 0 To m_t.nWidth - 1
   If m_t.bData(j * 16& + i) = 0 Then
    Do
     If nCount(b) > 0 Then
      m_t.bData(j * 16& + i) = b
      nCount(b) = nCount(b) - 1
      Exit Do
     End If
     b = b + 1
     If b >= &H100& Then
      b = -1
      Exit For
     End If
    Loop
   End If
  Next i
 Next j
Else
 For i = 0 To m_t.nObjectCount - 1
  m_t.bData(m_t.bObjectPos(i)) = m_t.bObjectType(i)
 Next i
End If
'///update laser
UpdateGameState
End Sub

Friend Sub SaveToLevel(ByRef t As typeFakeLaserLevel)
Dim i As Long, j As Long, b As Long
Dim idx As Long
'///
t = m_t
Erase t.bObjectPos, t.bObjectType
t.nObjectCount = 0
t.nHintCount = 0
'///save hint
For i = 0 To m_t.nHintCount - 1
 idx = m_t.bObjectPos(i)
 b = t.bData(idx)
 If IsObject(b) Then
  t.bObjectPos(t.nObjectCount) = idx
  t.bObjectType(t.nObjectCount) = b
  t.bData(idx) = 0
  t.nObjectCount = t.nObjectCount + 1
  t.nHintCount = t.nHintCount + 1
  If t.nObjectCount >= 4 Then Exit For
 End If
Next i
If t.nHintCount = 0 Then t.nHintCount = 1
'///save target
For j = 0 To t.nHeight - 1
 For i = 0 To t.nWidth - 1
  idx = j * 16& + i
  b = t.bData(idx)
  Select Case b
  Case 6 To 9, &H17& To &H1A&
   If t.nObjectCount >= 63 Then Exit For
   t.bObjectPos(t.nObjectCount) = idx
   t.bObjectType(t.nObjectCount) = b
   t.bData(idx) = 0
   t.nObjectCount = t.nObjectCount + 1
  End Select
 Next i
Next j
'///save other objects
For j = 0 To t.nHeight - 1
 For i = 0 To t.nWidth - 1
  idx = j * 16& + i
  b = t.bData(idx)
  If b >= 2 Then
   If t.nObjectCount < 63 Then
    t.bObjectPos(t.nObjectCount) = idx
    t.bObjectType(t.nObjectCount) = b
    t.nObjectCount = t.nObjectCount + 1
   End If
   t.bData(idx) = 0
  End If
 Next i
Next j
End Sub

Private Sub DrawLaserBeam(ByVal hdc As Long, ByRef r As RECT, ByRef hbr() As Long, ByRef hpn() As Long, ByVal clr As Long)
Select Case clr
Case 0 'black, do nothing
Case 1: FillRect hdc, r, hbr(4)
Case 2: FillRect hdc, r, hbr(5)
Case 4: FillRect hdc, r, hbr(6)
Case 7: FillRect hdc, r, hbr(3)
Case Else 'extended!!!
 clr = CreateSolidBrush(((clr And &H1&) <> 0 And &HFF&) Or _
 ((clr And &H2&) <> 0 And &HFF00&) Or _
 ((clr And &H4&) <> 0 And &HFF0000))
 FillRect hdc, r, clr
 DeleteObject clr
End Select
End Sub

Friend Sub Draw(ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal bEditMode As Boolean)
Dim i As Long, j As Long, k As Long
Dim b As Long
Dim hbr(16) As Long, hpn(4) As Long
Dim p(11) As POINTAPI, n(3) As Long
Dim r As RECT, r2 As RECT
'///
hbr(1) = GetStockObject(NULL_BRUSH)
hbr(2) = GetStockObject(BLACK_BRUSH)
hbr(3) = GetStockObject(WHITE_BRUSH)
hbr(4) = CreateSolidBrush(vbRed)
hbr(5) = CreateSolidBrush(vbGreen)
hbr(6) = CreateSolidBrush(vbBlue)
hbr(7) = CreateSolidBrush(&H808080)
hbr(8) = CreateSolidBrush(&H80&)
hbr(9) = CreateSolidBrush(&H8000&)
hbr(10) = CreateSolidBrush(&H800000)
hbr(11) = CreateSolidBrush(vbYellow)
hbr(12) = CreateSolidBrush(vbMagenta)
hbr(13) = CreateSolidBrush(vbCyan)
hbr(14) = CreateSolidBrush(&H8080&)
hbr(15) = CreateSolidBrush(&H800080)
hbr(16) = CreateSolidBrush(&H808000)
'///
hpn(1) = GetStockObject(NULL_PEN)
hpn(2) = GetStockObject(WHITE_PEN)
hpn(3) = CreatePen(0, 1, &H808080)
'///
hbr(0) = SelectObject(hdc, hbr(1))
hpn(0) = SelectObject(hdc, hpn(1))
'///draw background
r.Right = nWidth
r.Bottom = nHeight
FillRect hdc, r, hbr(3)
'///calc size
nWidth = nWidth \ m_t.nWidth
nHeight = nHeight \ m_t.nHeight
If nWidth > nHeight Then nWidth = nHeight
hpn(4) = CreatePen(0, nWidth * 0.0625! + 1!, &H808080)
'///draw map
r.Bottom = 0
For j = 0 To m_t.nHeight - 1
 r.Top = r.Bottom
 r.Bottom = r.Bottom + nWidth
 r.Right = 0
 For i = 0 To m_t.nWidth - 1
  r.Left = r.Right
  r.Right = r.Right + nWidth
  b = m_t.bData(j * 16& + i)
  '///
  Select Case b
  Case 1
   'wall, do nothing
  Case &HA& To &HC& 'color blocks
   FillRect hdc, r, hbr(b - 2)
  Case &H1B& To &H1D& 'more color blocks
   FillRect hdc, r, hbr(b - 13)
  Case &HF&, &H11& 'down/up splitter
   FillRect hdc, r, hbr(7)
   r2.Left = r.Left
   r2.Top = r.Top + nWidth * 0.4!
   r2.Right = r.Right
   r2.Bottom = r.Top + nWidth * 0.6!
   FillRect hdc, r2, hbr(2)
   r2.Left = r.Left + nWidth * 0.4!
   r2.Right = r.Left + nWidth * 0.6!
   If b = &HF& Then 'down
    r2.Top = r.Top + nWidth \ 2&
    r2.Bottom = r.Bottom
   Else 'up
    r2.Top = r.Top
    r2.Bottom = r.Top + nWidth \ 2&
   End If
   FillRect hdc, r2, hbr(2)
  Case &H10&, &H12& 'left/right splitter
   FillRect hdc, r, hbr(7)
   r2.Left = r.Left + nWidth * 0.4!
   r2.Top = r.Top
   r2.Right = r.Left + nWidth * 0.6!
   r2.Bottom = r.Bottom
   FillRect hdc, r2, hbr(2)
   r2.Top = r.Top + nWidth * 0.4!
   r2.Bottom = r.Top + nWidth * 0.6!
   If b = &H10& Then 'left
    r2.Left = r.Left
    r2.Right = r.Left + nWidth \ 2&
   Else 'right
    r2.Left = r.Left + nWidth \ 2&
    r2.Right = r.Right
   End If
   FillRect hdc, r2, hbr(2)
  Case &H13& To &H16& 'prism
   n(0) = hbr(7) 'white
   n(1) = hbr(9)
   n(2) = hbr(8) 'red
   n(3) = hbr(10) 'blue
   p(0).x = r.Left + nWidth \ 2&
   p(0).y = r.Top + nWidth \ 2&
   p(1).x = r.Left
   p(1).y = r.Bottom
   p(2).x = r.Right
   p(2).y = r.Bottom
   p(3) = p(0)
   p(4) = p(2)
   p(5).x = r.Right
   p(5).y = r.Top
   p(6) = p(0)
   p(7) = p(5)
   p(8).x = r.Left
   p(8).y = r.Top
   p(9) = p(0)
   p(10) = p(8)
   p(11) = p(1)
   For k = 0 To 3
    SelectObject hdc, n(((k + b - &H13&) And 3&))
    Polygon hdc, p(k * 3&), 3
   Next k
   SelectObject hdc, hbr(1)
  Case Else
   FillRect hdc, r, hbr(2)
   Select Case b
   Case 2 To 5, &H1A& 'laser and black target
    SelectObject hdc, hpn(2)
    Ellipse hdc, r.Left, r.Top, r.Right, r.Bottom
    If b = &H1A& And (m_nLaserData(j * 16& + i) And &H10000) = 0 Then
     'draw a face :-3
     Ellipse hdc, r.Left + nWidth * 0.2!, r.Top + nWidth * 0.2!, r.Left + nWidth * 0.4!, r.Top + nWidth * 0.4!
     Ellipse hdc, r.Left + nWidth * 0.6!, r.Top + nWidth * 0.2!, r.Left + nWidth * 0.8!, r.Top + nWidth * 0.4!
     Ellipse hdc, r.Left + nWidth * 0.25!, r.Top + nWidth * 0.6!, r.Left + nWidth * 0.75!, r.Top + nWidth * 0.9!
    End If
    SelectObject hdc, hpn(1)
   Case 6 To 9 'target
    SelectObject hdc, hbr(b + 1 - ((m_nLaserData(j * 16& + i) And &H10000) <> 0 And 4&))
    Ellipse hdc, r.Left, r.Top, r.Right, r.Bottom
    SelectObject hdc, hbr(1)
   Case &H17& To &H19& 'more target
    SelectObject hdc, hbr(b - 9 - ((m_nLaserData(j * 16& + i) And &H10000) <> 0 And 3&))
    Ellipse hdc, r.Left, r.Top, r.Right, r.Bottom
    SelectObject hdc, hbr(1)
   End Select
  End Select
 Next i
Next j
'///draw laser
r.Bottom = 0
For j = 0 To m_t.nHeight - 1
 r.Top = r.Bottom
 r.Bottom = r.Bottom + nWidth
 r.Right = 0
 For i = 0 To m_t.nWidth - 1
  r.Left = r.Right
  r.Right = r.Right + nWidth
  b = m_nLaserData(j * 16& + i)
  '///down
  r2.Left = r.Left + nWidth * 0.4375!
  r2.Right = r.Left + nWidth * 0.5625!
  r2.Top = r.Top + nWidth \ 2&
  r2.Bottom = r.Bottom
  DrawLaserBeam hdc, r2, hbr, hpn, b And &HF&
  '///up
  r2.Top = r.Top
  r2.Bottom = r.Top + nWidth \ 2&
  DrawLaserBeam hdc, r2, hbr, hpn, (b And &HF00&) \ &H100&
  '///left
  r2.Top = r.Top + nWidth * 0.4375!
  r2.Bottom = r.Top + nWidth * 0.5625!
  r2.Left = r.Left
  r2.Right = r.Left + nWidth \ 2&
  DrawLaserBeam hdc, r2, hbr, hpn, (b And &HF0&) \ &H10&
  '///right
  r2.Left = r.Left + nWidth \ 2&
  r2.Right = r.Right
  DrawLaserBeam hdc, r2, hbr, hpn, (b And &HF000&) \ &H1000&
 Next i
Next j
'///draw overlay layer
r.Bottom = 0
For j = 0 To m_t.nHeight - 1
 r.Top = r.Bottom
 r.Bottom = r.Bottom + nWidth
 r.Right = 0
 For i = 0 To m_t.nWidth - 1
  r.Left = r.Right
  r.Right = r.Right + nWidth
  b = m_t.bData(j * 16& + i)
  '///
  Select Case b
  Case &HD&, &HE&
   p(0).x = r.Left + nWidth * 0.1!
   p(0).y = r.Top
   p(1).x = r.Right
   p(1).y = r.Top + nWidth * 0.9!
   p(2).x = r.Left + nWidth * 0.9!
   p(2).y = r.Bottom
   p(3).x = r.Left
   p(3).y = r.Top + nWidth * 0.1!
   If b = &HE& Then '\-mirror
    For k = 0 To 3
     p(k).x = r.Left + r.Right - p(k).x
    Next k
   End If
   SelectObject hdc, hbr(7)
   Polygon hdc, p(0), 4
   SelectObject hdc, hbr(1)
  End Select
 Next i
Next j
'///draw hint
If bEditMode Then
 SelectObject hdc, hpn(2)
 If m_t.nHintCount >= 1 Then
  i = m_t.bObjectPos(0)
  j = i \ &H10&
  i = i And &HF&
  r.Left = i * nWidth
  r.Top = j * nWidth
  r.Right = r.Left + nWidth * 0.3! + 1!
  r.Bottom = r.Top + nWidth * 0.4! + 1!
  FillRect hdc, r, hbr(2)
  FrameRect hdc, r, hbr(3)
  p(0).x = r.Left + nWidth * 0.2!
  p(0).y = r.Top + nWidth * 0.1!
  p(1).x = p(0).x
  p(1).y = r.Top + nWidth * 0.3! + 1!
  p(11).x = 2
  PolyPolyline hdc, p(0), p(11).x, 1
 End If
 If m_t.nHintCount >= 2 Then
  i = m_t.bObjectPos(1)
  j = i \ &H10&
  i = i And &HF&
  r.Left = i * nWidth
  r.Top = j * nWidth
  r.Right = r.Left + nWidth * 0.3! + 1!
  r.Bottom = r.Top + nWidth * 0.4! + 1!
  FillRect hdc, r, hbr(2)
  FrameRect hdc, r, hbr(3)
  p(0).x = r.Left + nWidth * 0.1!
  p(0).y = r.Top + nWidth * 0.1!
  p(1).x = r.Left + nWidth * 0.2!
  p(1).y = p(0).y
  p(2).x = p(1).x
  p(2).y = r.Top + nWidth * 0.2!
  p(3).x = p(0).x
  p(3).y = p(2).y
  p(4).x = p(0).x
  p(4).y = r.Top + nWidth * 0.3!
  p(5).x = p(1).x + 1
  p(5).y = p(4).y
  p(11).x = 6
  PolyPolyline hdc, p(0), p(11).x, 1
 End If
 If m_t.nHintCount >= 3 Then
  i = m_t.bObjectPos(2)
  j = i \ &H10&
  i = i And &HF&
  r.Left = i * nWidth
  r.Top = j * nWidth
  r.Right = r.Left + nWidth * 0.3! + 1!
  r.Bottom = r.Top + nWidth * 0.4! + 1!
  FillRect hdc, r, hbr(2)
  FrameRect hdc, r, hbr(3)
  p(0).x = r.Left + nWidth * 0.1!
  p(0).y = r.Top + nWidth * 0.1!
  p(1).x = r.Left + nWidth * 0.2!
  p(1).y = p(0).y
  p(2).x = p(1).x
  p(2).y = r.Top + nWidth * 0.3!
  p(3).x = p(0).x - 1
  p(3).y = p(2).y
  p(4).x = p(0).x
  p(4).y = r.Top + nWidth * 0.2!
  p(5).x = p(1).x
  p(5).y = p(4).y
  p(11).x = 4
  p(11).y = 2
  PolyPolyline hdc, p(0), p(11).x, 2
 End If
 If m_t.nHintCount >= 4 Then
  i = m_t.bObjectPos(3)
  j = i \ &H10&
  i = i And &HF&
  r.Left = i * nWidth
  r.Top = j * nWidth
  r.Right = r.Left + nWidth * 0.3! + 1!
  r.Bottom = r.Top + nWidth * 0.4! + 1!
  FillRect hdc, r, hbr(2)
  FrameRect hdc, r, hbr(3)
  p(0).x = r.Left + nWidth * 0.1!
  p(0).y = r.Top + nWidth * 0.1!
  p(1).x = p(0).x
  p(1).y = r.Top + nWidth * 0.2!
  p(2).x = r.Left + nWidth * 0.2!
  p(2).y = p(1).y
  p(3).x = p(2).x
  p(3).y = p(0).y
  p(4).x = p(2).x
  p(4).y = r.Top + nWidth * 0.3! + 1!
  p(11).x = 3
  p(11).y = 2
  PolyPolyline hdc, p(0), p(11).x, 2
 End If
 SelectObject hdc, hpn(1)
ElseIf m_nHintIndex >= 0 Then
 i = (m_nHintIndex And &HF&) * nWidth
 j = ((m_nHintIndex And &HF0&) \ &H10&) * nWidth
 k = ((m_nHintIndex And &HF00&) \ &H100&) * nWidth
 b = ((m_nHintIndex And &HF000&) \ &H1000&) * nWidth
 '///
 If i = k Then 'vertical
  p(0).x = i + nWidth \ 2&
  p(0).y = j + nWidth \ 2&
  p(1).x = k + nWidth \ 2&
  p(1).y = b + nWidth \ 2&
  p(2).x = k + nWidth \ 4&
  p(2).y = b + (nWidth And (j > b))
  p(3) = p(1)
  p(4).x = k + nWidth - nWidth \ 4&
  p(4).y = p(2).y
  p(11).x = 2
  p(11).y = 3
 Else 'horizontal or both
  p(0).x = i + nWidth \ 2&
  p(0).y = j + nWidth \ 2&
  p(1).x = i + nWidth \ 2&
  p(1).y = b + nWidth \ 2&
  p(2).x = k + nWidth \ 2&
  p(2).y = b + nWidth \ 2&
  p(3).x = k + (nWidth And (i > k))
  p(3).y = b + nWidth \ 4&
  p(4) = p(2)
  p(5).x = p(3).x
  p(5).y = b + nWidth - nWidth \ 4&
  p(11).x = 3
  p(11).y = 3
 End If
 '///
 SetROP2 hdc, vbXorPen
 SelectObject hdc, hpn(4)
 PolyPolyline hdc, p(0), p(11).x, 2
 SelectObject hdc, hpn(1)
 SetROP2 hdc, vbCopyPen
End If
'///draw selection
If m_nLastIndex >= 0 Or m_nCurrentIndex >= 0 Then
 SetROP2 hdc, vbXorPen
 SelectObject hdc, hpn(3)
 If m_nLastIndex >= 0 Then
  i = m_nLastIndex And &HF&
  j = m_nLastIndex \ &H10&
  r.Left = i * nWidth
  r.Top = j * nWidth
  Rectangle hdc, r.Left + 8, r.Top + 8, r.Left + nWidth - 8, r.Top + nWidth - 8
  Rectangle hdc, r.Left + 6, r.Top + 6, r.Left + nWidth - 6, r.Top + nWidth - 6
 End If
 If m_nCurrentIndex >= 0 Then
  i = m_nCurrentIndex And &HF&
  j = m_nCurrentIndex \ &H10&
  r.Left = i * nWidth
  r.Top = j * nWidth
  Rectangle hdc, r.Left + 4, r.Top + 4, r.Left + nWidth - 4, r.Top + nWidth - 4
  Rectangle hdc, r.Left + 2, r.Top + 2, r.Left + nWidth - 2, r.Top + nWidth - 2
 End If
 SelectObject hdc, hpn(1)
 SetROP2 hdc, vbCopyPen
End If
'///over
SelectObject hdc, hbr(0)
SelectObject hdc, hpn(0)
For i = 4 To UBound(hbr)
 If hbr(i) Then DeleteObject hbr(i)
Next i
For i = 3 To UBound(hpn)
 If hpn(i) Then DeleteObject hpn(i)
Next i
End Sub
